home *** CD-ROM | disk | FTP | other *** search
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- END
- Attribute VB_Name = "ObjPicture"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
-
- Public objects As New Collection
-
- Const TYPE_STRING = "3D APF PICTURE"
-
-
- ' ************************************************
- ' Find an object that contains this point.
- ' ************************************************
- Function NearestObject(x As Single, y As Single) As Object
- Dim obj As Object
-
- ' Find the object.
- For Each obj In objects
- If obj.Contains(x, y) Then
- Set NearestObject = obj
- Exit Function
- End If
- Next obj
- Set NearestObject = Nothing
- End Function
-
-
- Function ObjectType() As String
- ObjectType = TYPE_STRING
- End Function
-
- ' ************************************************
- ' Save the picture to a new metafile.
- ' ************************************************
- Sub SaveWMF(name As String)
- Dim mhdc As Integer
- Dim hMF As Integer
- Dim status As Long
-
- ' Create the metafile.
- mhdc = CreateMetaFile(ByVal name)
- If mhdc = 0 Then
- Beep
- MsgBox "Error creating metafile """" & name & """"."
- Exit Sub
- End If
-
- MakeWMF mhdc
-
- hMF = CloseMetaFile(mhdc)
- status = DeleteMetaFile(hMF)
- End Sub
-
-
- ' ************************************************
- ' Save the objects in the picture into a metafile.
- ' ************************************************
- Sub MakeWMF(mhdc As Integer)
- Dim obj As Object
-
- For Each obj In objects
- obj.MakeWMF mhdc
- Next obj
- End Sub
-
-
-
- ' ************************************************
- ' Read the picture from a file using Input.
- ' Assume TYPE_STRING has already been read.
- ' ************************************************
- Sub FileInput(filenum As Integer)
- Dim num As Integer
- Dim i As Integer
- Dim obj As Object
- Dim obj_type As String
-
- ' Read the number of objects in the file.
- Input #filenum, num
-
- ' Repeatedly read objects from the file.
- For i = 1 To num
- Input #filenum, obj_type
- Select Case obj_type
- Case TYPE_STRING
- Set obj = New ObjPicture
- Case "POLYLINE"
- Set obj = New ObjPolyline
- Case "GRID"
- Set obj = New ObjGrid3D
- Case "SPARSE_GRID"
- Set obj = New ObjSparseGrid
- Case "BEZIER"
- Set obj = New ObjBezier
- Case "BSPLINE"
- Set obj = New ObjBSpline
- Case Else
- Beep
- MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
- Exit Sub
- End Select
- obj.FileInput filenum
- objects.Add obj
- Next i
- End Sub
-
- ' ************************************************
- ' Draw the picture on a Form, Printer, or
- ' PictureBox.
- ' ************************************************
- Sub Draw(canvas As Object, Optional r As Variant)
- Dim obj As Object
-
- For Each obj In objects
- obj.Draw canvas, r
- Next obj
- End Sub
-
- ' ************************************************
- ' Write the picture to a file using Write.
- ' Begin with TYPE_STRING to identify this object.
- ' ************************************************
- Sub FileWrite(filenum As Integer)
- Dim obj As Object
-
- Write #filenum, TYPE_STRING
- Write #filenum, objects.Count
-
- For Each obj In objects
- obj.FileWrite filenum
- Next obj
- End Sub
-
- ' ************************************************
- ' Apply a nonlinear transformation to the objects.
- ' ************************************************
- Sub Distort(trans As Object)
- Dim obj As Object
-
- For Each obj In objects
- obj.Distort trans
- Next obj
- End Sub
-
-
- ' ************************************************
- ' Apply a transformation matrix which may not
- ' contain 0, 0, 0, 1 in the last column to the
- ' objects.
- ' ************************************************
- Sub ApplyFull(M() As Single)
- Dim obj As Object
-
- For Each obj In objects
- obj.ApplyFull M
- Next obj
- End Sub
- ' ************************************************
- ' Apply a transformation matrix to the objects.
- ' ************************************************
- Sub Apply(M() As Single)
- Dim obj As Object
-
- For Each obj In objects
- obj.Apply M
- Next obj
- End Sub
-
-